home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / bp7bugs1.zip / TRASHSRC.ZIP / TRASHREP.PAS < prev   
Pascal/Delphi Source File  |  1993-01-03  |  2KB  |  80 lines
  1. program TrashRep;
  2.  
  3. { The trash report }
  4.  
  5. function HexB(b:byte):string;
  6. const
  7.   hexdigit : array[0..15] of char = ('0','1','2','3','4','5','6','7',
  8.                                      '8','9','A','B','C','D','E','F');
  9. begin
  10.   HexB := hexdigit[b shr 4] + hexdigit[b and $F];
  11. end;
  12.  
  13. function HexW(w:word):string;
  14. begin
  15.   HexW := HexB(hi(w)) + HexB(lo(w));
  16. end;
  17.  
  18. type
  19.   regs = (reax,rebx,recx,redx,resi,redi,rebp,rfs,rgs);
  20.   TIntRec = record   { This record must be exactly 16 bytes long!!! }
  21.     oldisr : pointer;
  22.     counts : array[regs] of byte;
  23.     junk   : array[14..16] of byte;
  24.   end;
  25.  
  26.   TIntRecArray = array[0..15] of TIntRec;
  27.   PIntRecArray = ^TIntRecArray;
  28.  
  29.  
  30. const
  31.   sigstart : longint = $73696854; { "This" }
  32.   sigend = ' is the Trash Detector!';
  33.   intnum : array[0..15] of byte = (8,9,$A,$B,$C,$D,$E,$F,
  34.                                   $70,$71,$72,$73,$74,$75,$76,$77);
  35.   regname : array[regs] of string[3] = ('EAX','EBX','ECX','EDX','ESI','EDI',
  36.                                         'EBP','FS','GS');
  37.  
  38. var
  39.   table : PIntRecArray;
  40.   segment : word;
  41.   sig : pointer;
  42.   sigrest : array[1..23] of char;
  43.   i : integer;
  44.   r : regs;
  45.   found,trashed : boolean;
  46. begin
  47.   writeln('TrashRep - Report on trashed extended registers.');
  48.   writeln('Written by D.J. Murdoch, January 1993, for the public domain.');
  49.   writeln;
  50.   found := false;
  51.   for segment := $0 to $FFFF do
  52.   begin
  53.     sig := ptr(segment,256);
  54.     if longint(sig^) = sigstart then
  55.     begin
  56.       sig := ptr(segment,256+4);
  57.       move(sig^,sigrest,23);
  58.       if sigrest = sigend then
  59.       begin
  60.         writeln('Trash detector found at segment ',HexW(segment));
  61.         trashed := false;
  62.         found := true;
  63.         table := ptr(segment,0);
  64.         for i:=0 to 15 do
  65.           for r := reax to rgs do
  66.             if table^[i].counts[r] <> 0 then
  67.             begin
  68.               writeln('Interrupt ',HexB(intnum[i]),' trashed register ',regname[r],' ',
  69.                       table^[i].counts[r],' times.');
  70.               trashed := true;
  71.             end;
  72.         if not trashed then
  73.           writeln('No problems detected (yet :-).');
  74.       end;
  75.     end;
  76.   end;
  77.   if not found then
  78.     writeln('Trash detector not found.  Run TRASHDET.');
  79. end.
  80.